#!/usr/bin/env gosh
(use srfi-1)
(use sxml.ssax)
(use sxml.serializer)
(use sxml.tools)
(use sxml.tree-trans)
(use gauche.process)

;;文字列 "Factorial #{n} = #{(fact n)}"から
;;S式 (string-append "Factorial " (x->string n) " = " (x->string (fact n))) を生成する

(define (process-text text)
  (if (not (string? text))
    text
    (let loop ((l '())
	       (text text))
      (cond 
       ((#/\#\{([^\}]*)\}/ text) =>
	(lambda (m)
	  (loop (cons `(x->string ,(read-from-string (m 1))) (cons (m 'before) l)) (m 'after))))
       ((#/\$\{([^\}]*)\}/ text) =>
	(lambda (m)
	  (loop (cons `(sxml:string->html (x->string ,(read-from-string (m 1)))) (cons (m 'before) l)) (m 'after))))
       ((null? l) text)
       (else (list 'unquote `(string-append ,@(reverse (cons text l)))))))))

(define (transform sxml)
  ;; (@ ((href "http://localhost") (name "hoge))) のcdrを取り出す
  (define (attributes-ref a)
    (and (not (null? a))
	 (eq? '@ (car a))
	 (not (null? (cdr a)))
	 (cdr a)))

  (pre-post-order
   sxml
   `((choose *macro* . ,(lambda (tag a . elems)
			  (and-let* ((attr (attributes-ref a)))
			    (let ((test-exp (read-from-string (cadar attr)))
				  (then-exp (or (assq 'then elems) '(then "")))
				  (else-exp (or (assq 'else elems) '(else ""))))
			      (list 'unquote `(if ,test-exp
						,(list 'quasiquote (cadr then-exp))
						,(list 'quasiquote (cadr else-exp))))))))
     (foreach *macro* . ,(lambda (tag a . elems)
			   (and-let* ((attr (attributes-ref a)))
			     (let ((item (caar attr))
				   (items (read-from-string (cadar attr))))
			       `(unquote-splicing (append-map (lambda (,item)
								,(list 'quasiquote elems))
							      ,items))))))
     (include . ,(lambda (tag . elems)
		   (let ((file (car elems)))
		     (cadr (call-with-input-process `(gosh tt.scm ,file)
			     (lambda (in) (ssax:xml->sxml in '())))))))

     (*PI* . ,(lambda (tag target str)
		(list 'unquote (read-from-string str))))
     (*text* . ,(lambda (trigger x) 
		  (process-text x)))
     (*default* . ,(lambda x x)))))

(define (eval-sxml env sxml)
  (eval `(let ,env
	   ,(list 'quasiquote sxml))
	(interaction-environment)))

(define (template-engine env in)
  (format #t (srl:sxml->html (eval-sxml env (transform (ssax:xml->sxml in '()))))))

(define (main args)
  (define env '((name "Gemma")
		(items '("alice" "bob" "charlie" "dave" "ellen" "foxtrot" "golf" "hotel" "india" "juliet" "kilo"))
		(fact (lambda (x) (apply * (iota x 1))))))

  (if (null? (cdr args))
    (template-engine env (current-input-port))
    (call-with-input-file (cadr args)
      (lambda (in)
	(template-engine env in))))
  (exit))


